perm filename MTVAL.VLI[VLI,LSP] blob sn#382036 filedate 1978-09-08 generic text, type T, neo UTF8
(STATUS 2 1 2)


(DE SEVAL (E A) (COND
  ((ATOM E) (CASSQ E A))
  ((= (CAR E) QUOTE) (CADR E))
  ((= (CAR E) 'IF) (COND
      ((SEVAL (CADR E) A) (SEVAL (CADDR E) A))
      (T (SEVAL (CADDDR E) A))))
  (T (SAPPLY (CAR E) (SEVLIS (CDR E) A) A))))

(DE CADDDR (X) (CAR (CDDDR X)))
 
(DE SEVLIS (E A) (AND E (CONS (SEVAL (CAR E) A) (SEVLIS (CDR E) A))))

(DE SAPPLY (F L A ;; X)
(AND (GET F 'SYMB) (NOT (GET F 'ITER))
  (SETQ L (MAPCAR L '(LAMBDA (Y) (COND
      ((AND (LISTP Y) (= (CAR Y) '***))
       (SETQ X '(***))
       (CDR Y))
      (T Y)))))
)
  (APPEND X (COND
  ((= F 'LIST) L)
  ((= F 'CAR) (CAAR L))
  ((= F 'CDR) (CDAR L))
  ((= F 'NULL) (NULL (CAR L)))
  ((= F 'CONS) (CONS (CAR L) (CADR L)))
  (T (SETQ F (GET F 'SYMB))
     (SEVAL (CADDR F) (PAIRLIS (CADR F) L A))))))

(SETQ A '((*** . ***) (NIL . NIL) (T . T)))

(DF DS (L) (PUT (CAR L) (CONS LAMBDA (CDR L)) 'SYMB))

(DF DSI (L) (PUT (CAR L) NIL 'ITER)
            (PUT (CAR L) (CONS LAMBDA (CDR L)) 'SYMB))



(PROGN (STATUS 1 1 2) '(LOAD  MTVAL))